PsL Monthly 1993 December

home *** CD-ROM | disk | FTP | other *** search

/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / langwn1.exe / SAMPLE04.BAS < prev next >

Wrap

BASIC Source File | 1993-03-20 | 51.6 KB | 1,422 lines

' giving your user a set of scrollable lists, with files and ' sub-directories that can be selected, is a common GUI technique. ' SAMPLE04.BAS shows how to use LangWin to achieve this effect. ' a mode 4 (wallpaper) window is used as background. ' several unmovable windows (of the same ' color as background window) with no shadows, ' are created to provide several ' scrollable lists in "one" window. ' the directory and file access routines are used to create ' scrollable lists of files and sub-directories. by clicking ' on a sub-directory, you can change into it, and it's contents ' (files and directories) will then be displayed in the scrollable ' lists. ' this sample also shows how to use an error recovery routine ' in the main module to detect when a drive is not ready, ' and allow the user to retry or quit the operation. ' subroutine DoFiles (which also calls ChgPath and SortIt) is ' meant to be a stand-alone routine that you can copy and use ' in your own programs. it implements techniques to create ' a "menu" with drives, sub-directories, files, and the current directory. ' these can be scrolled, selected, and/or changed. DECLARE FUNCTION ChgPath% (NewPath$) ' changes to new path DECLARE SUB DoFiles () ' menu of files, dirs, drives DECLARE SUB SortIt (s$()) ' bubble sort DECLARE SUB Main () ' main window DECLARE FUNCTION VidType% () ' gets type of monitor DECLARE SUB ProcessFiles (Qual$, Text$()) ' sample routine to process files ' must compile with qb /ah /L langwin '$DYNAMIC make all arrays dynamic DEFINT A-Z '$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin. ' NOTE: LANGWIN.BI contains all definitions found ' in QB.BI, so include for QB.BI is not needed. CLEAR , , 5000 ' set stack at 5000 bytes '--------------------------------------------------------------- ' first see if EGA or VGA monitor mm = VidType IF mm <> 3 AND mm <> 4 THEN BEEP PRINT PRINT "LangWin's GUI only supports EGA and VGA." PRINT END END IF '---------------------------------------------------------------- ' SHARED VARIABLES ' - dlett$: MUST contain the letter of the drive that is being ' referenced by the GetCurDir$ function. ' if the drive is not ready, the error routine in the main module will ' get control and use dlett$ in its error message. ' - ignor: used a flag for the error routine. when a drive is selected but ' not ready, the error routine gets control and opens a window that ' contains a RETRY button and possinly an IGNORE button. ' if ignor=0 then IGNORE button is NOT displayed; else it is displayed. ' selecting RETRY will cause the instruction that generated the ' "not ready" error to be retried. selecting IGNORE will pass control ' to the instruction after the one generating the error condition. ' - Ldrives: number of logical drives on the system ' - OneFlop: flag set (TRUE) if system has one floppy, else FALSE DIM SHARED dlett$, ignor, Ldrives, OneFlop '----------------------------------------------------------------- ON ERROR GOTO ErrorTrap ' enable error routine '----------------------------------------------------------------- ' get attribute from current screen so it can be restored upon exit OrigAttr = SCREEN(1, 1, 1)' save original attribute from row 1, col 1 '------------------------------------------------------------------- ' if WIDTH command is used, it must be placed before call to LangWinInit ' because code in LangWinInit extracts max rows/cols from screen and saves ' in global variables. WIDTH 80, 25 '---------------------------------------------------------------------- ' these variables MUST be defined BEFORE call to LangWinInit. ' keep these as low as possible to conserve memory at run time. MaxWindows = 10 ' max simultaneous open windows MaxButtons = 40 ' max number of objects (including text labels) active MaxTextLines = 200 ' maximum number of text lines in any scrollable win MaxTextWins = 4 ' max windows that can have scrollable text ' must be <= MaxWindows LOCATE , , 0 ' start with hidden text cursor SCREEN 0, , 0, 0 ' text mode CALL LangWinInit ' initialize (if mouse exists, it will be displayed) ' if you get "subscript out of range" error while ' in this routine, be sure you called QB with /ah. ' then try reducing the value of MaxWindows. ' check the WIDTH command; reduce number of columns, ' and/or number of rows. '--------------------------------------------------------------------- ' get actual number of logical drives on the system ' get # drives from ChangeDrive (i.e., int 21h, function 0Eh). ' value will be max of 5 or # logical drives specified ' in LASTDRIVE parm in config.sys (i.e., LASTDRIVE=c will cause ChangeDrive ' to return 5, not 3, as # logical drives - that's a DOS quirk, not mine). ' LASTDRIVE=g will cause ChangeDrive to return a 7. ' drives specified in LASTDRIVE parm, however, might not be actual ' number of drives on system (LASTDRIVE=z doesn't mean you have 26 drives) ' so, after we get LASTDRIVES value, we must determine how many logical ' drives really exist (without attempting to read from them ' which could produce a drive not ready error) - that is, we need to know ' how many drives are actually configured on the system, not how many ' are ready at this moment. dd$ = GetCurDrive$ ' current default drive Ldrives = ChangeDrive(dd$) 'get LASTDRIVES value ' now see how many drives are actually there ' step through each drive (starting with #1) and try to ' change to it with ChangeDrive. if successful, continue with loop. ' if unsuccessful, then previous drive was last drive on the system. FOR i = 1 TO Ldrives dl$ = CHR$(ASC("A") - 1 + i) ' compute a drive letter x = ChangeDrive(dl$) ' try to change to it IF x < 0 THEN ' successful? Ldrives = i - 1 ' can't change to drive i, change value of ldrives EXIT FOR ' stop scan END IF NEXT x = ChangeDrive(dd$) ' now change back to original drive '-------------------------------------------------------------------- ' on systems with only one physical floppy drive, it can be logically ' referenced as both A: and B: (dos handles this). ' however, if the A: drive is "active" and you try and access the B: drive, ' dos will display the following message: ' "Insert diskett for drive B: and press any key when ready" ' unfortunately, you cannot control the placement of this message and it will ' ruin an otherwise attractive display of windows. ' if the system has one floppy, and either A: or B: is selected by user, ' i assume that both drive letters refer to the same physical drive, ' and i first make the appropriate logical letter "active" before the ' drive is accessed. this should avoid the dos message. ' a not ready condition will be detected, and an error window opened, ' if the A: or B: drive (which has been made active) is not ready ' (i.e., does not have a floppy inserted and the door closed). ' the byte at &H504 is used to make either A: or B: active. ' if it is set to 0, then A: is active; if 1 then B: is active ' (assuming that there is only one floppy on the system). ' the word at &H410 contains info on system equipment. ' if bit 0 is set, then the system has floppies. ' in that case, bits 6 & 7 indicate the number of floppies minus 1 ' (i.e., if bits 6 & 7 are 0, then system has 1 floppy drive). ' first, lets see if this system has only one floppy drive OneFlop = FALSE ' default for flag DEF SEG = 0 ' establish addressability to low memory IF (PEEK(&H410) AND &H1) = 1 THEN ' test bit 0 to see if any floppies ' floppies exist, see how many ' set flag if only one IF (PEEK(&H410) AND &HC0) = 0 THEN OneFlop = TRUE END IF DEF SEG ' restore addressability ' the OneFlop flag will be used later (when a disk is selected) ' to determine if there's only one drive on the system, ' if only one floppy drive and either A: or B: is selected, then the ' corresponding logical drive must first made "active" (via byte at &H504) ' BEFORE any I/O is attempted on that drive. this will avoid DOS detecting ' that activity was attempted on an "inactive" logical drive and displaying ' the dreaded "insert diskett" message right in the middle ' of an otherwise nice looking display. ' if your system has only one ' floppy, and you want to see the effect of this DOS ' message, just set OneFlop=FALSE below this comment, ' and select the B: drive. '----------------------------------------------------------------------- ' display "wallpaper" IF HaveMouse THEN CALL HideMouseCursor ' first hide mouse pointer CLS CALL SetColor(8, 15) FOR i = 1 TO MaxRows LOCATE i, 1 PRINT STRING$(80, 178); ' can try 176, 177, or 178 NEXT IF HaveMouse THEN CALL ShowMouseCursor ' display the mouse pointer '============================================================== CALL Main '===================================================================== IF HaveMouse THEN HideMouseCursor ' we're done with the mouse bbb = (OrigAttr AND &HF0) \ 16 ' mask & shift to get original background fff = OrigAttr AND &HF ' mask to get original foreground PALETTE ' restore original palette CALL SetColor(fff, bbb) ' restore orig foreground/background CLS LOCATE , , 1 ' make text cursor visible END '============================================================= ' error routine - when drive not ready, will open win with message ' - if file to be deleted, will set flag and return error # ErrorTrap: SELECT CASE ERR ' determine which error occured CASE 71 ' drive not ready ' dlett$ MUST be SHARED and contain the letter of the drive that ' is being referenced by the GetCurDir$ function. ' ignor MUST be SHARED and is used a flag. ' if ignor=0 then IGNORE button is NOT displayed; else it is displayed. BEEP ' open modal window with no close button nr = BlankWin(16, 1, 23, 31, 4, 15, 1, 15, 0, 2) x = ShowWinText(2, 4, 15, "DRIVE " + UCASE$(dlett$) + ": NOT READY!") r1 = MakePushButton(4, 4, 7, "RETRY", 15, 3, 1) IF ignor <> 0 THEN q1 = MakePushButton(4, 19, 8, "IGNORE", 15, 3, 1) ' wait for a button press DO wn = WinEvent(action)' wait for an event ' since error window was modal, it's the only one ' that can return events. no need to test for window number IF action = 3 THEN ' button press? button = WinParms(CurWinPtr, 16) x = CloseWindow SELECT CASE button' which button? CASE r1 ' retry RESUME CASE q1 ' ignore RESUME NEXT END SELECT END IF LOOP CASE ELSE ' any other error ON ERROR GOTO 0 ' display the error END SELECT END REM $STATIC FUNCTION ChgPath (NewPath$) ' change path function ' INPUT: ' NewPath$: path to change to (can contain drive and directory) ' OUTPUT: ' 0: change was successful ' -1: invalid drive letter ' -2: drive not ready - current ' -3: drive not ready - spec in NewPath$ ' -4: invalid dir name or could not change to dir dlett$ = GetCurDrive$ ' save drive letter (get current drive). ' GetCurDrive$ will not do i/o to disk, ' thus it will not detect drive not ready ' (returns upper case value) ' if 2nd char in input field is colon (:), ' then assume first is a drive letter. ' get it (cvt to UCASE) and save in dlett$. IF MID$(NewPath$, 2, 1) = ":" THEN orglett$ = (LEFT$(NewPath$, 1)) ' extract letter dlett$ = UCASE$(orglett$) ' convert to UCASE END IF ' at this point, dlett$ has current drive letter (if NewPath$ did not ' specify a drive), or it has the drive letter specified in NewPath$ x = ASC(dlett$) ' get ascii value of the letter ' see if drive "letter" was valid and within range of real drives ' (the global variable Ldrives is defined in main module) IF x < ASC("A") OR x > ASC("A") - 1 + Ldrives THEN ' drive "letter" was NOT valid ' either it was not a letter, or not a real drive on system ' open modal window with error msg BEEP y = BlankWin(9, 1, 16, 37, 4, 15, 1, 15, 0, 2) y = ShowWinText(2, 2, 15, "Invalid drive letter specified: " + orglett$) y = MakePushButton(4, 7, 4, "OK", 15, 3, 1) y = WinEvent(z) ' wait for any event y = CloseWindow ChgPath = -1 ' return code EXIT FUNCTION ' bail out END IF ' drive letter was valid ' if system has only one floppy, and either A: or B: was selected, ' make that logical drive active to avoid the dos "insert diskette" ' message when attempting to do I/O to an inactive logical floppy. ' (OneFlop global variable is defined in the main module). IF OneFlop THEN ' only one floppy on system? IF dlett$ = "A" THEN ' was A: selected ? DEF SEG = 0 flopsav = PEEK(&H504) ' save original POKE &H504, 0 ' set A: active DEF SEG ELSEIF dlett$ = "B" THEN ' else was b: selected ? DEF SEG = 0 flopsav = PEEK(&H504) ' save original POKE &H504, 1 ' set B: active DEF SEG END IF END IF ' change to new dir ignor = 1 ' flag to display IGNORE button if drive not ready x = 1234 ' init x to a value never returned by ChangeDir x = ChangeDir(NewPath$) ' change to specified directory ' ChangeDir() will cause i/o to defualt drive. ' not ready condition will be detected and processed by error ' routine in main module. if IGNORE selected, x will remain set ' to 1234. ignor = 0 ' reset flag ' lets see if drive was not ready and user selected ignore IF x = 1234 THEN ' drive is not ready ' if single floppy system & drive A/B was selected, reset active floppy ' back to original state IF OneFlop AND (dlett$ = "A" OR dlett$ = "B") THEN DEF SEG = 0 POKE &H504, flopsav ' restore orig value DEF SEG END IF ' see if it was the current drive or some other (in NewPath$) not ready IF dlett$ = GetCurDrive$ THEN ' the current drive is not ready ChgPath = -2 ' set return code ELSE ' drive specified in NewPath$ was not ready (it was not current drive) ChgPath = -3 ' set return code END IF EXIT FUNCTION ' bail out ' drive was ready (or made ready). see if ChangeDir was ok ELSEIF x < 0 THEN 'could not change to dir specified ' open modal window with no close icon BEEP y = BlankWin(9, 1, 16, 37, 4, 15, 1, 15, 0, 2) ' display message with reason IF x = -1 THEN y = ShowWinText(2, 2, 15, "Invalid dir name specified") ELSE y = ShowWinText(2, 2, 15, "Could not change dir") END IF y = MakePushButton(4, 7, 4, "OK", 15, 3, 1) y = WinEvent(z) ' wait for any event y = CloseWindow ChgPath = -4 ' set return code EXIT FUNCTION ' bail out ELSE ' change to new dir was ok, ' change default drive (we know its ok and ready) x = ChangeDrive(dlett$)' change to new drive IF x < 0 THEN END ' error not likely since prev ChangDir was ok END IF ' end of code to test for error in ChangeDir ChgPath = 0 ' successful return code END FUNCTION SUB DoFiles ' this subroutine can be copied and used in your own programs ' (don't forget that it calls ChgPath and SortIt). ' DoFiles creates a "menu" with ' drives, sub-directories, files, and the current path. ' these can be scrolled, selected and/or changed. ' it uses the following LangWin functions: ' GetCurDrive$ get the current drive's letter ' ChangeDrive change the current drive ' GetCurDir$ get the current dir's name ' ChangeDir change the current dir ' GetFileNames get names of files in current drive:dir ' just click on the dir or drive you want to change to. ' the files in that directory will be displayed. ' click on file name to select it. click on GO to see a list ' of all file names selected (in practice, your code would do something ' with this list; like move, copy, delete, etc). ' ' the code in this routine could easily be modified to display ' an input field where the user could enter a file spec. ' you could use this file spec in the calls ' to GetFileNames(2, "*.*", Text$()) instead of the "*.*" parameter. ' in that way, only selected files matching the file spec would be displayed. ' i'll leave this modification as an exercise to the reader. ' this subroutine actually opens 4 separate windows, one each for ' drives, sub-directories, files, and current path. all windows use ' the same color scheme, and are placed over a window with "wallpaper" mode ' to give the illusion that there's really only one "menu" with multiple ' sections (when actually, 4 separate windows are displayed and used). ' therefore, we need to allow the mouse to select any of these 4 windows, ' but NOT any other underlying windows (which would then be made active and ' overlay part of "menu"). we can't make the 4 windows in the "menu" modal; ' that would prevent selection of objects in all but the active window. ' so, PRIOR to calling this DoFiles, all other open windows must ' be manually set to mode 4 (wallpaper) and reset to their original mode upon ' return. by setting other windows to mode 4, clicks on these other windows ' will be ignored. the following shows sample code to do this. it assumes one ' window, whose number is saved in variable main1, is open (if multiple ' windows were open, this code could easily be modified to set the mode of ' all open windows to 4): ' ' this code would be placed in the main moudle prior to calling DoFiles ' ' get handle of window whose number is main1, save in main1han ' ' (assume it's open at this point, no need to test return code) ' x = IsWinOpen(main1, main1han) ' zz = WinParms(main1han, 19)' save current mode of main1 win ' WinParms(main1han, 19) = 4 ' set mode of main1 win to wallpaper ' CALL DoFiles ' WinParms(main1han, 19) = zz ' restore mode '=================== INITIALIZATION ========================== ' get current disk letter and directory DefaultDisk$ = GetCurDrive$ ' get current drive letter dlett$ = DefaultDisk$ ' shared variable - used in error routine ignor = 1 ' flag to display IGNORE button if not ready DefaultDir$ = "NOT READY" ' default to specific string DefaultDir$ = GetCurDir$("") ' get current dir (i/o to drive) ignor = 0 ' reset flag skip1 = FALSE ' flag to skip display of all windows but drives IF DefaultDir$ = "NOT READY" THEN skip1 = TRUE ' set skip flag if not ready '---- BUILD THE MENU WITH DRIVES, SUB-DIRS, FILES, AND PATH ------- '====================== WALLPAPER ============================= ' first, place a "wallpaper" window on the screen. ' this window will have a shadow and be the foundation of the menu. ' other windows with same color will be placed over this wallpaper window ' to give the impression of one menu with multiple scrollable lists. ' these other windows will be shadowless and unmovable. PALETTE 4, 57 ' temporarily set attrib 4 to 57 (9) to min visual impact wal = BlankWin(1, 10, 24, 46, -4, 1, 2, 15, 0, 4) x = ShowWinText(22, 10, 15, "Double Click Files") x = ShowWinText(23, 8, 15, " Then Click GO Button ") '====================== DISPLAY DRIVES ================================== ' array to hold drive names (Ldrives was determined in main module) REDIM Text$(1 TO Ldrives) ' for each drive on the system, ' make an array with drive letters in the form [-x-] FOR i = 1 TO Ldrives Text$(i) = "[-" + CHR$(ASC("A") - 1 + i) + "-]" NEXT ' open a window and display the drives ' i'll omit error checking since all parms are static ' i'll also assume that Ldrives < MaxTextLines (else all drive names will not ' be displayed in the scrollable list). drv = OpenScrollWindow(16, 33, 22, 46, -9, 15, 1, 15, Text$(), 2, 3, 5, 11, 0, -1) x = ShowTitle("DRIVES", 14, 9) '======================== DISPLAY DIRECTORIES ========================= REDIM Text$(1 TO 1) ' clear the array IF NOT skip1 THEN ' bypass if default drive not ready GOSUB XtractSubDirs ' go get sorted list of sub-dirs END IF ' end bypass if not ready ' open a window for the directories ' i'll omit error checking since all parms are static dirs = OpenScrollWindow(7, 33, 15, 46, -9, 15, 1, 15, Text$(), 2, 3, 7, 11, 0, -1) x = ShowTitle("DIRS", 14, 9) '============================ DISPLAY FILES IN CURRENT DIR =============== IF NOT skip1 THEN ' bypass if default drive not ready REDIM Text$(1 TO 1) ' clear the array GOSUB XtractFileNames ' go get file names END IF ' end of bypass if default drive not ready ' open a window for the files ' i'll omit error checking since all parms are static fil = OpenScrollWindow(7, 10, 22, 32, -9, 15, 1, 15, Text$(), 2, 3, 14, 19, 0, -1) x = ShowTitle("SELECT FILES", 14, 9) ERASE Text$ ' save string memory until needed '============================ DISPLAY CURRENT PATH ======================= pa = BlankWin(1, 10, 6, 46, -9, 15, 1, 15, 0, -1) a$ = DefaultDisk$ + ":" + DefaultDir$ ' build current path string x = ShowTitle("PATH", 14, 9) pathn = MakeInputField(1, 2, 33, a$, 15, 1) cd = MakePushButton(3, 3, 9, "Chg Dir", 15, 4, 1) ggo = MakePushButton(3, 14, 4, "GO", 15, 4, 1) quit = MakePushButton(3, 20, 6, "EXIT", 15, 4, 1) PALETTE 4, 4 ' reset attribute 4 (instructions at bottom of menu will ' now be shown over a red background) '===================== main loop ======================= DO wn = WinEvent(action) ' wait for an event SELECT CASE wn ' which window caused the event? CASE drv ' drives window caused the event ' save index of text line with focus. ' it is equivalent to logical drive number (A=1, B=2, etc) dnum = WinParms(CurWinPtr, 15) ' get index of text line with focus dlett$ = CHR$(ASC("A") - 1 + dnum) ' convert to a letter ' if system has only one floppy, and either A: or B: was selected, ' make that logical drive active to avoid the dos "insert diskette" ' message when attempting to do I/O to an inactive logical floppy. ' (OneFlop global variable is defined in the main module). IF OneFlop THEN ' only one floppy on system? IF dlett$ = "A" THEN ' was A: selected ? DEF SEG = 0 flopsav = PEEK(&H504) ' save original POKE &H504, 0 ' set A: active DEF SEG ELSEIF dlett$ = "B" THEN ' else was b: selected ? DEF SEG = 0 flopsav = PEEK(&H504) ' save original POKE &H504, 1 ' set B: active DEF SEG END IF END IF ' now, let's make sure selected drive is ready. ' if not, i'll display an error window. ' if the drive is ready, then ChangeDrive will be used ' to make it current. however, ' before making the selected drive current with ChangeDrive, ' use GetCurDir$ to see if it's ready ' (by getting current dir on that drive). ' ChangeDrive will successfully change to a logical drive, even if ' it's not ready. so, we need something to actually attempt to read ' from the drive to see if it's ready. GetCurDir$ will do this and ' detect if it's ready or not. if not ready, DOS will trap the ' error and transfer to the error routine in the main module ' (as long as we've executed an ON ERROR GOTO xxx statement there). ' if drive is not ready, error routine ' will get control, open a window, and give the user two choices: ' RETRY or IGNORE. The RETRY will cause a RESUME to be executed. ' this returns control to the same statement that caused the error ' (GetCurDir$) and it will be executed again. ' the IGNORE will cause a RESUME NEXT to be executed. this ' returns control to the statement AFTER the GetCurDir$ command that ' caused the error. ' by initializing a$ to "not ready", we can tell ' if GetCurDir$ was executed and if it was successful. ' when GetCurDir$ is executed, it returns a value that will be ' placed into a$. Thus, if a$ changes from "not ready", ' then we know GetCurDir$ was executed. ' if drive was not ready, and ' user selected IGNORE, then the RESUME NEXT will cause ' the GetCirDir$ statement to be skipped, and a$ will ' still be set to "not ready". ' in this case, we won't attempt to change to the selected drive. ' if a$ is something other than "not ready", then ' i'll assume GetCurDir$ was successful (not necessarily a valid ' assumption, you should check for error codes that could ' be returned from GetCurDir$). ignor = 1 ' set flag to display the ignore button in drive not ready win a$ = "NOT READY" ' initialize a$ a$ = GetCurDir$(dlett$) ' if successful, a$ will be the dir ignor = 0 ' reset flag ' if successfully able to get current dir on new drive, ' then a$ will no longer be set to "not ready". in this case, ' change to new drive, get dirs and files, and show them in windows IF a$ <> "NOT READY" THEN ' drive is ready x = ChangeDrive(dlett$)' change to new drive IF x < 0 THEN END ' error not likely since prev GetCurDir was ok GOSUB ShowNewStuff ' refresh dir, files, & path wins ELSE ' drive is not ready ' if single floppy system & drive A/B, reset active floppy IF OneFlop AND (dlett$ = "A" OR dlett$ = "B") THEN DEF SEG = 0 POKE &H504, flopsav ' restore orig value DEF SEG END IF END IF CASE dirs ' dir window caused the event ' new dir was selected. ' must update the dir, files, and path windows ' get the name of dir selected (ie with focus) ' from the text array displayed in the dir window. i = WinParms(CurWinPtr, 18) ' slot of text for this window j = WinParms(CurWinPtr, 15) ' entry with focus a$ = SaveText(i, j) ' line of text with focus (ie dir name) ' bypass if dir name was dot (.); we're already there ' bypass if special names: <NONE> or (Incomplete List) IF a$ <> "." AND a$ <> "<NONE>" AND a$ <> "(Incomplete List)" THEN dlett$ = GetCurDrive$ ' in case not ready will have drive letter x = 1234 ' set to value never returned by ChangeDir ignor = 1 ' flag to display ignore button if disk not ready x = ChangeDir(a$) ' make that dir current ' ChangeDir() will cause i/o to defualt drive. ' not ready condition will be detected and processed by error ' routine in main module. if IGNORE selected, x will remain set ' to 1234. ignor = 0 ' reset flag ' bypass if drive was not ready and ignore button selected IF x <> 1234 THEN ' if x is 1234, drive was not ready IF x < 0 THEN END ' errors not likely since choice was from list GOSUB ShowNewStuff ' call sub to refresh dir, files, and path wins END IF END IF CASE fil ' files window caused the event ' lets get the name of file selected (ie with focus) ' from the text array displayed in the files window. i = WinParms(CurWinPtr, 18) ' slot of text for this window j = WinParms(CurWinPtr, 15) ' entry with focus a$ = SaveText(i, j) ' line of text with focus ' bypass if special names: ' <NONE> or (Incomplete List) IF a$ <> "<NONE>" AND a$ <> "(Incomplete List)" THEN 'toggle selection character IF MID$(a$, 2, 1) = "X" THEN MID$(a$, 2, 1) = " " ' un-select ELSE MID$(a$, 2, 1) = "X" ' select END IF SaveText(i, j) = a$ CALL ReShowText ' re-display text in win END IF CASE pa ' pathname window ' only action is the change path button IF action = 3 THEN SELECT CASE WinParms(CurWinPtr, 16) ' select button CASE ggo ' go process selected files ' first make sure that contents of input field on screen ' is indeed the current dir. ' if not, user probably made a change to the input field, ' and hit the GO button instead of the Chg Dir button ' get current drive and dir dlett$ = GetCurDrive$ ' get current drive ignor = 1 ' ignore button displayed if not ready cdir$ = "NOT READY" ' set a default value cdir$ = GetCurDir$("") ' get current dir ignor = 0 ' reset flag to display IGNORE button skip1 = FALSE ' initialize flag used to skip processing ' when current drive is not ready and ' IGNORE clicked ' if cdir$ remains set to "NOT READY", then current drive ' was not ready and user selected IGNORE. ' in this case, set flag so further processing will be skipped IF cdir$ = "NOT READY" THEN skip1 = TRUE Fqual$ = dlett$ + ":" + cdir$ ' build full qualifier ' we now have current drive and dir, compare to input field ' (bypass this test if drive was not ready and ignore selected) IF Fqual$ <> ButtonsText(pathn) AND NOT skip1 THEN ' current path <> input field on screen BEEP y = BlankWin(6, 1, 17, 57, 4, 15, 1, 15, 0, 2) ' display message with reason y = ShowWinText(2, 2, 15, "Ambiguous path name detected - files NOT processed.") y = ShowWinText(3, 2, 15, "Above path does not match current drive & dir:") y = ShowWinText(4, 2, 14, Fqual$) y = ShowWinText(6, 2, 15, "If necessary, use the Chg Dir button to change paths.") y = ShowWinText(7, 2, 15, "Then use the GO button to process selected files.") y = MakePushButton(9, 7, 4, "OK", 15, 3, 1) y = WinEvent(z) ' wait for any event y = CloseWindow skip1 = TRUE ' set bypass flag END IF ' ----- process all files selected ------------- ' processing will be bypassed if current drive was not ready ' and user clicked IGNORE (in this case, skip1 will be TRUE). IF NOT skip1 THEN ' add trailing \ to fully qualified path if not root IF cdir$ <> "\" THEN Fqual$ = Fqual$ + "\" ' build an array with file names that were selected REDIM Text$(1 TO MaxTextLines) x = IsWinOpen(fil, fhan) ' we know win # (fil), get handle (fhan) slot = WinParms(fhan, 18) ' slot of text for this window ' scan text array, move all files marked with [X] to Text$ txtptr = 0 ' slot in Text$ to get entry FOR j = 1 TO WinParms(fhan, 17) ' scan text array ' find selected entries (will have [X] as 1st 3 characters) IF LEFT$(SaveText(slot, j), 3) = "[X]" THEN ' current entry in SaveText was selected lfil = LEN(SaveText(slot, j)) - 4 ' len of file name txtptr = txtptr + 1 ' bump pointer to next Text$ slot ' this condition should never occur - safety net IF txtptr > MaxTextLines THEN END ' move file name (without the [X]) to Text$ array Text$(txtptr) = RIGHT$(SaveText(slot, j), lfil) END IF NEXT ' if no items selected in Text$, display error message IF txtptr = 0 THEN BEEP y = BlankWin(17, 1, 24, 37, 4, 15, 1, 15, 0, 2) y = ShowWinText(2, 2, 15, "No files were selected.") y = MakePushButton(5, 7, 4, "OK", 15, 3, 1) y = WinEvent(z) ' wait for any event y = CloseWindow ELSE ' Text$ array has been built, go process its contents CALL ProcessFiles(Fqual$, Text$()) ' process selected files ' now redisplay contents of files window. ' we could just change the [X] to [ ] and ' redisplay the original list of file names. ' however, the processing performed in ProcessFIles ' could have changed the contents of the current directory ' (for example, the selected files could have been deleted). ' therefore, the current contents of the current directory ' are first determined (using GetFileNames), then displayed. REDIM Text$(1 TO 1) ' clear the array GOSUB XtractFileNames ' go get current file names CALL NewFocusWindow(fhan) ' give focus to files window CALL RefreshScrollText(Text$()) ' redisplay new file list END IF ERASE Text$ ' clear array to save string memory END IF ' end of test to bypass CASE quit ' quit GOSUB CloseAll ' go close all open windows EXIT DO ' bail out CASE cd ' change dir rr = ChgPath(ButtonsText(pathn)) ' go change path SELECT CASE rr ' test return code CASE -2 ' current drive is not ready cdir$ = "NOT READY" ' current drive is not ready skip1 = TRUE ' to skip display of dirs & files GOSUB ShowNewStuff1 ' go update path window CASE ELSE GOSUB ShowNewStuff ' go update all windows END SELECT ' end of select for change path END SELECT ' end of select button in path win END IF ' end of code to process action in path name window END SELECT LOOP ' continue until main window is closed EXIT SUB '======================================================= ' sub to re-display current sub-dirs, files, and path. ' called when change made in directory, drive, or path window ' (after appropriate drive and/or dir has been made current). ShowNewStuff: dlett$ = GetCurDrive$ ' just in case not ready condition ignor = 1 ' ignore option displayed cdir$ = "NOT READY" cdir$ = GetCurDir$("") ignor = 0 ' reset flag skip1 = FALSE ' flag to skip display of dirs & files windows IF cdir$ = "NOT READY" THEN skip1 = TRUE ' set skip flag if drive not ready ' second entry point - called if drive specified in input field was current ' and it was not ready. no need to check current drive's ' readiness again. ShowNewStuff1: ' ========== DIRS ================== ' get new list of sub-dirs in current dir and redisplay then REDIM Text$(1 TO 1) ' clear the array IF NOT skip1 THEN ' bypass if default drive not ready GOSUB XtractSubDirs ' go get sorted list of sub-dirs END IF ' end of bypass in default drive not ready x = IsWinOpen(dirs, wh) ' get handle of dirs window CALL NewFocusWindow(wh) ' make it current CALL RefreshScrollText(Text$()) ' redisplay new dir list ' ============== FILES ============== IF NOT skip1 THEN ' bypass if default drive not ready REDIM Text$(1 TO 1) ' clear the array GOSUB XtractFileNames ' get file names END IF ' end of bypass if defualt drive not ready x = IsWinOpen(fil, wh) ' get handle of files window CALL NewFocusWindow(wh) ' make it current CALL RefreshScrollText(Text$()) ' redisplay new file list ERASE Text$ ' save string memory ' =========== PATH ============== ' if selected path refs a drive that's not ready, ' and user selects IGNORE, then we must reset path input field to current ' path (otherwise, it will contain the not ready drive ' which could confuse the user since file and dir windows still have ' data from current path). ' make the path window current x = IsWinOpen(pa, wh) ' get handle of window CALL NewFocusWindow(wh) ' make it current a$ = dlett$ + ":" + cdir$ ' build path string ButtonsText(pathn) = a$ ' set to new path ReShowInputField (pathn)' redisplay input field RETURN '========================================================= ' close all open files CloseAll: ' reset palette for wallpaper window so it looks blue ' during closure of other windows PALETTE 4, 57 ' change color of wallpaper win to blue ' while over-laying windows are closed ' (to minimize visual impact). will be changed back later ' close the windows with numbers: pa, fil, dirs, drv, wal IF IsWinOpen(pa, Han) THEN ' get handle CALL NewFocusWindow(Han) ' if open, make win active x = CloseWindow ' close it END IF IF IsWinOpen(fil, Han) THEN ' get handle CALL NewFocusWindow(Han) ' if open, make win active x = CloseWindow ' close it END IF IF IsWinOpen(dirs, Han) THEN ' get handle CALL NewFocusWindow(Han) ' if open, make win active x = CloseWindow ' close it END IF IF IsWinOpen(drv, Han) THEN ' get handle CALL NewFocusWindow(Han) ' if open, make win active x = CloseWindow ' close it END IF IF IsWinOpen(wal, Han) THEN ' get handle CALL NewFocusWindow(Han) ' if open, make win active x = CloseWindow ' close it END IF ' reset palette back to red PALETTE 4, 4 RETURN '=================================================================== ' get sub-dirs, place into Text$, and sort XtractSubDirs: ' get any sub-directories in current directory x = GetFileNames(1, "*.*", Text$()) zer = OutRegs.ax ' save in case an unknown error occured ' test for errors IF x < 0 THEN SELECT CASE x CASE -2 ' no matches Text$(1) = "<NONE>" CASE ELSE ' except for the case where there are no dirs (-2 case), ' i'll leave error checking to you. ' other errors are straight forward. once your code is debugged, ' they should not occur. BEEP z = BlankWin(14, 6, 21, 52, 5, 15, 1, 15, 0, 2) z = ShowWinText(2, 4, 15, "Unknown error reading sub-dirs: " + STR$(zer)) z = MakePushButton(4, 14, 4, "OK", 15, 3, 1) z = WinEvent(w) ' wait for any action z = CloseWindow GOSUB CloseAll ' close all open windows EXIT SUB ' bail out END SELECT END IF CALL SortIt(Text$()) ' sort the dirs RETURN '================================================================= ' get file names, prefix with [ ], place into Text$, sort XtractFileNames: ' get files in current directory x = GetFileNames(2, "*.*", Text$()) zer = OutRegs.ax ' save in case an unknown error occured ' insert [ ] in front of file names FOR i = LBOUND(Text$) TO UBOUND(Text$) IF LEN(Text$(i)) > 0 THEN Text$(i) = "[ ] " + Text$(i) NEXT ' test for errors IF x < 0 THEN SELECT CASE x CASE -2 ' no matches Text$(1) = "<NONE>" CASE ELSE ' except for the case where there are no files (-2 case), ' i'll leave error checking to you. ' other errors are straight forward. once your code is debugged, ' they should not occur. BEEP z = BlankWin(14, 6, 21, 52, 5, 15, 1, 15, 0, 2) z = ShowWinText(2, 4, 15, "Unknown error reading files: " + STR$(zer)) z = MakePushButton(4, 14, 4, "OK", 15, 3, 1) z = WinEvent(w) ' wait for any action z = CloseWindow GOSUB CloseAll ' close all open windows EXIT SUB ' bail out END SELECT END IF CALL SortIt(Text$()) ' sort the files RETURN END SUB SUB Main ' this subroutine will open a window, display a GO button and the current ' directory's name. clicking the GO button will give control to the ' DoFiles subroutine which will open several windows: ' directory, drive, and files. ' while these windows are visible, you will be able to change the current ' directory or drive (and the corresponding files will be displayed). ' note the technique used to determine if the default drive is not ready. ' the variable used to save the current directory's name (DefaultDir$) is set ' to a default value. a flag (ignor) is set so the IGNORE button will be ' displayed in an error window if a "not ready" condition occurs. ' the GetCurDir$ function is called to get the current directory's name. ' this causes i/o to the default drive (note that GetCurDrive$ will NOT ' cause i/o to the current drive, DOS maintains the current drive's ' designation internally so i/o is not necessary). ' if the drive is not ready, the error routine (defined in the main module) ' will get control. the error routine tests for a not ready condition and ' if that condition caused the error, a window is opened. the window ' will have a RETRY button, and if the ignor flag is 1, it will also ' have an IGNORE button. ' if RETRY is selected, control is returned to the GetCurDir$ function ' (the current directory's name is returned and saved in ' the variable DefaultDir$). if the IGNORE button is clicked, then control ' is returned to the instruction after the call to GetCurDir$, and the ' the DefaultDir$ variable will retain it's original value. ' thus, by comparing the DefaultDir$ variable to its default setting, ' you can determine if the drive was not ready and IGNORE selected. DefaultDisk$ = GetCurDrive$ ' get current drive's letter dlett$ = DefaultDisk$ ' dlett$ variable is used by error routine DefaultDir$ = "NOT READY" ' set default ignor = 1 ' set flag: IGNORE button will be visible DefaultDir$ = GetCurDir$("") ' error window will be open if drive not ready ignor = 0 ' reset flag: IGNORE button not displayed ' if current drive was not ready, and IGNORE button clicked, ' then the DefaultDir$ variable will still contain the ' default string "NOT READY". compare to see if not ready error occured. ' in that case (default drive not ready), display window and exit. IF DefaultDir$ = "NOT READY" THEN BEEP bail1 = BlankWin(3, 1, 10, 43, 9, 15, 1, 15, 0, 2) x = ShowWinText(2, 2, 15, "Default drive could not be made ready") x = ShowWinText(3, 2, 15, "Program terminating ...") ok1 = MakePushButton(5, 7, 6, "BYE!", 15, 4, 1) wn = WinEvent(action)' wait x = CloseWindow ' any action - close EXIT SUB END IF ' main window tr = 1 'top row tc = 3 'top col br = 9 'bottom row bc = 60 'bottom col ' open a window to contain the current directory's name and a GO button main1 = BlankWin(tr, tc, br, bc, 3, 15, 2, 15, 0, 1) x = MakeHorizLine(4, 2) ' horizontal line x = ShowWinText(5, 2, 15, "Current directory:") ' label for dir's name ' the current directory's name could now be displayed using a ' call to ShowWinText. however, the current dir name can be changed ' dynamically (via the DoFiles subroutine that is called by clicking ' the GO button). thus, upon return from DoFiles, we need a technique ' for changing the text that shows the current directory's name. ' this could be done by calling ShowWinText to display the current dir's ' name "over" the text with the old dir name. however, ' each call to ShowWinText uses a unique handle to access LangWin's data ' structures (the global MaxButtons defines the maximum number of handles). ' since the new dir name is displayed "over" the old name, there's really ' no reason for using up a new handle for the new dir name. we need a way to ' "reuse" the same handle to save the dir name's text and then display it. ' to accomplish this (ie, to reuse the existing handle), we must first ' determine what the handle number is. ShowWinText does NOT return a handle ' value, so we must figure out what the handle number is before we can ' reuse it. this can be done by first using ShowWinText to create text with a ' known value. then, by scanning LangWin's data structure ' (ie the ButtonsText() array) for that known value, the handle ' number can be determined. thereafter, the ReShowInputField(handle) ' can be used to redisplay the text (after changing its value ' in ButtonsText(handle) to the new dir's name). x = ShowWinText(6, 2, 14, "KNOWN VALUE") ' define specific text ' now scan all button text to find handle of above text cdnam = -999 ' default handle number FOR i = 1 TO MaxButtons ' scan the entire data structure IF ButtonsText(i) = "KNOWN VALUE" THEN ' look for specific text cdnam = i ' if match, save handle EXIT FOR ' terminate search END IF NEXT ' see if we have a serious problem, could not find specific text IF cdnam = -999 THEN CLS BEEP PRINT "INTERNAL ERROR" PRINT "COULD NOT FIND HANDLE FOR SPECIFIC TEXT" END END IF ' at this point, cdnam contains handle where current dir name is saved a$ = DefaultDisk$ + ":" + DefaultDir$ ' fully qualified dir name ButtonsText(cdnam) = a$ ' update value in data structure CALL ReShowInputField(cdnam) ' redisplay the dir name ButtonsData(cdnam, 4) = LEN(a$) ' update length of area ggo = MakePushButton(2, 2, 4, "GO", 15, 5, 1) quit = MakePushButton(2, 30, 6, "QUIT", 15, 5, 1) x = ShowTitle(" SAMPLE04 ", 3, 15)' place this last so title will be ' preserved if window is resized '========== MAIN LOOP ======================================== DO WHILE AnyWinOpen wn = WinEvent(action) ' wait for an event SELECT CASE wn ' which window caused the event? CASE main1 ' only buttons exist IF action = 3 THEN ' process the button SELECT CASE WinParms(CurWinPtr, 16) ' select button handle CASE ggo ' first, change mode of main win to wallpaper ' this will prevent selection of this win while the ' multiple windows opened in DoFiles are visible ' get handle of window whose number is main1, save in main1han ' (it's open at this point, no need to test return code) x = IsWinOpen(main1, main1han) zz = WinParms(main1han, 19)' save mode of main win WinParms(main1han, 19) = 4 ' set mode of main win to wallpaper CALL DoFiles WinParms(main1han, 19) = zz ' restore original mode ' now redisplay the current dir name (which could have ' been changed while in DoFiles) using the original handle ' (saved in cdnam). ' get current disk letter and directory dlett$ = GetCurDrive$ ' variable used by error routine ignor = 0 ' set flag to hide IGNORE button. ' (ignoring a not ready condition on the ' default drive upon returning from ' DoFiles will not be an option). cdir$ = GetCurDir$("") ' get current dir name cd$ = dlett$ + ":" + cdir$ ' build fully qualified dir name ButtonsText(cdnam) = cd$ ' update data structure ReShowInputField (cdnam) ' redisplay current dir name ButtonsData(cdnam, 4) = LEN(cd$) 'update length CASE quit ' open modal window with no close icon clos = BlankWin(1, 1, 7, 31, 4, 15, 1, 15, 0, 2) x = ShowWinText(2, 2, 15, "Do you really want to quit?") quity1 = MakePushButton(4, 7, 5, "YES", 15, 3, 1) quitn1 = MakePushButton(4, 19, 4, "NO", 15, 3, 1) ' make "no" the default button WinParms(CurWinPtr, 16) = quitn1 ' put handle in data structure CALL ChangeButtonFocus(quitn1, 0) ' redisplay button with reverse video END SELECT END IF ' end of code for main1 window CASE clos ' modal win asking if user really wants to quit ' only action that could occur is button press IF action = 3 THEN 'but just in case, lets check the action SELECT CASE WinParms(CurWinPtr, 16) ' handle of button clicked CASE quity1 ' yes button ' following code is not technically necessary, ' you could just EXIT DO here, and return ' to the calling program (if you know that ' all the calling program will do is exit). ' however, if calling program will do other tasks, ' we must close all open windows before leaving, so ... xx = CloseWindow' close the current win ' now close all other windows ' scan WinStack backwards, get win handle, ' make it active, then close it FOR i = LastWinStack TO 1 STEP -1 CALL NewFocusWindow(WinStack(i)) ' make win active x = CloseWindow ' close it NEXT EXIT DO ' bail out CASE quitn1 ' no button in close warning window ' user changed their mind, just close the current window xx = CloseWindow END SELECT END IF ' end of code for clos window END SELECT ' end of code to process window numbers LOOP ' now restore original drive & dir ' first restore dir. ' then if it's not ready and ignore button clicked, ' we can skip restoring the drive. dlett$ = DefaultDisk$ ' needed by error routine ignor = 1 ' flag to display IGNORE button x = 1234 ' set default as a return code never used by ChangeDir ' ChangeDir() will cause i/o to defualt drive. ' not ready condition will be detected and processed by error routine ' in main module. if IGNORE selected, x will remain set to 1234. x = ChangeDir(DefaultDisk$ + ":" + DefaultDir$) ' fully qualified IF x <> 1234 THEN ' if x is still 1234, a not ready condition occured ' not ready condition did not occur ' so restore original drive IF x < 0 THEN END 'error not likely since Default Dir exists x = ChangeDrive(DefaultDisk$) IF x < 0 THEN END ' drive error not likely since above change dir ' was successful END IF EXIT SUB ' bail out END SUB SUB ProcessFiles (Qual$, Text$()) ' this is where you would place the code to process ' all selected files. ' Qual$ - contains the fully qualified path (drive & dir) for the files ' Text$() - contains the files selected ' in this sample, i'll just open a window and display the ' fully qualified names of all selected files ' add fully qualified path to file name FOR i = LBOUND(Text$) TO UBOUND(Text$) ' only modify non-null entries IF LEN(Text$(i)) > 0 THEN Text$(i) = Qual$ + Text$(i) NEXT ' open window to scroll file names hr1 = 1 ' start row hc1 = 1 ' start col hr2 = 18 ' end row hc2 = 56 ' end col hh = OpenScrollWindow(hr1, hc1, hr2, hc2, 2, 15, 2, 15, Text$(), 2, 2, hr2 - hr1 - 2 - 2, hc2 - hc1 - 2, 0, 2) x = MakeHorizLine(hr2 - hr1 - 3, 2) x = MakePushButton(hr2 - hr1 - 2, (hc2 - hc1) \ 2 - 2, 4, "OK", 15, 4, 1) x = ShowTitle(" SELECTED FILES ", 2, 15) DO x = WinEvent(aa) ' wait for any event LOOP WHILE aa = 2 ' loop if event was double click on text (aa=2) ' exit loop if event was ESC key (aa=1) or OK button (aa=3) x = CloseWindow ' close END SUB SUB SortIt (s$()) ' simple bubble sort - sort contents of s$ in ascending order strt = LBOUND(s$)' starting index en = UBOUND(s$)' ending index ' first scan backwards til first non-null entry. ' no need to sort them. en1 = strt ' default value in case all entries are null FOR i = en TO strt STEP -1 IF s$(i) <> "" THEN ' look for null en1 = i ' save new ending index EXIT FOR ' stop scan END IF NEXT ' if either 1 or no non-null entries, no need to sort IF en1 = strt THEN EXIT SUB ' do the sort FOR i = strt TO en1 - 1 FOR j = i + 1 TO en1 IF s$(j) < s$(i) THEN SWAP s$(j), s$(i) NEXT NEXT END SUB ' ===================================================== ' returns type of video display ' ' return values: ' 1: black/white (could be EGA/VGA with monochrome) ' 2: CGA (with color) ' 3: EGA (with color) ' 4: VGA (with color) ' 5: MCGA (with color) ' 99: other ' FUNCTION VidType ' quick & dirty, check &h463 DEF SEG = 0 IF PEEK(&H463) = &HB4 THEN ' see if monochrome VidType = 1 EXIT FUNCTION END IF DEF SEG ' first try int 10h, function 1Ah InRegs.ax = &H1A00 CALL INTERRUPTX(&H10, InRegs, OutRegs) IF (OutRegs.ax AND &HFF) = &H1A THEN ' see if int 10h, funct 1Ah supported code = (OutRegs.bx AND &HFF) ' get display code SELECT CASE code CASE 1 ' MDA VidType = 1 CASE 2 ' CGA VidType = 2 CASE 4 ' EGA color VidType = 3 CASE 5 ' EGA b/w VidType = 1 CASE 7 ' VGA b/w VidType = 1 CASE 8 ' VGA color VidType = 4 CASE 10 ' MCGA color VidType = 5 CASE 11 ' MCGA b/w VidType = 1 CASE ELSE VidType = 99 ' other END SELECT EXIT FUNCTION ELSE ' now try int 10h, function 12h, sub-function 10h InRegs.ax = &H1200 InRegs.bx = &H10 CALL INTERRUPTX(&H10, InRegs, OutRegs) IF (OutRegs.bx AND &HFF00) = 1 THEN ' see if monochrome VidType = 1 EXIT FUNCTION END IF IF (OutRegs.bx AND &HFF) <> &H10 THEN ' see if BL reg changed VidType = 3 ' EGA (not sure why it couldn't be VGA too!) EXIT FUNCTION END IF VidType = 99 ' other (probably CGA or MDA) END IF END FUNCTION